home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
peek173c.zip
/
RSB2PEEK.MRG
< prev
Wrap
Text File
|
1992-04-17
|
14KB
|
241 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RBBSSUB2.BAS to produce RBBSSUB2.NEW
* RBBSSUB2.BAS: Date 9-5-1991 Size 138506 bytes
* ------------[ Created 04-17-1992 ]------------
' $linesize:132
' $title: 'RBBSSUB2.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
' Copyright 1991 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB2.BAS
' First Released .....: February 11, 1990
' Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
' Copyright ..........: 1986 - 1991
' Purpose.............: The Remote Bulletin Board System for the IBM PC,
' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not
' require error trapping are incorporated within RBBSSUB 2-5 as
' separately callable subroutines in order to free up as much
' code as possible within the 64K code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' AnswerIt 200 Answer the telephone when it rings
' ASCIICodes 129 Allow a CONFIG string to have any ASCII value
' BadChar 455 Check user name for invalid characters
' BadName 20235 Check for system crash attempt with bad file name
' BankTime 5497 Let Caller change Banked Time ' RM040101
' Baud450 5507 Allow 300 baud callers to bump up to 450 baud
' CheckRatio 20096 Test upload/download ratio
' CheckMacro 1242 Checks for macro and processes
' CopyRight 97 Display RBBS-PC's copyright notice
' DefaultU 9600 Write out the user's defaults
' DenyAccess 1386 Downgrade security so access denied
' DoorExit 10983 Set up a .BAT file to exit RBBS-PC to a "door"
' DosExit 10934 Set up a .BAT file to exit to DOS (second level)
' EditALine 2618 Edits a single line
' EditDef 120 Edit configuration parameters
' FileNameCheck 20240 Matches file name to a prefix & extension
' GetArc 20140 Handle request for verbose listing
' GetCommand 101 Get RBBS-PC's node id from command line
' GetTime 9140 Calculates callers elapsed time (hh,mm,ss)
' GoIdle 90 Release resources when waiting for keyboard input
' KillMsg 3952 Delete old or unnecessary messages
' Line25 945 Build and/or update line 25 of RBBS-PC's local screen
' LineEdit 3700 Edit a line while minimizing string space consumption
' LogError 13660 Log error message to CALLERS file
' LPrnt 1480 Subroutine to write to local display
' Macro 1320 Check/execute Macro
' MLInit 8 Handle MultiLink initialization/de-initialization
' MsgProt 2055 Sets protection for a message
' MessageTo 2018 Sets who a message is to
' PageLen 5200 Change page length
' ParseIt 1637 Parses a string
' PassWrd 660 Verify user & message passwords
' PopCmdStack 1650 Get user input, 1st checking command stack
' PScrn 1483 Print to display
' QuickLPrnt 1482 Quickly writes count of blocks on file transfer
' QuickPeek 20340 Easy find user to send message to ' PEEK173C
' QuickTPut 1478 Fast, but limited, "TPut" equivalent
' QuickTPut1 1478 Outputs short string following by CR LF
' RBBSExit 10992 RBBS-PC exit to transfer control to other programs
' RecoverMsg 10410 Recover a deleted message
' RemNonAlf 5100 Removes non-alpha characters from a string
' RingCaller 1636 Ring caller's bell and put message in emphasis
' SetBaud 1654 Set baud rate in the 8250 chip of the RS232 interface
' SetCrLf 1496 Set up the necessary carriage return/line feed string
' SetSection 12000 Set the proper section prompts (main, file, util, libr)
' SetThread 4554 Set up request for threading thru messages
' SkipLine 1485 Write a # of blank lines to the communications port
' SearchCmd 1238 Searches list of commands in RBBS for a request
' SecViolation 1380 Process a security violation
' SysMenu 112 Displays sysop menu/status
' SysopChat 4773 Sysop and caller chat
' TestRel 336 Tests for Reliable connect
' TGet 1498 Read a line from the communications port
' TPut 1396 Write a line to the communications port
' Trim 105 Strip leading and trailing blanks from a string
' TrimTrail 107 Strip off specified string off end of another string
' UntilRight 12878 Ask a question until user says answer is right
' UpdateU 10600 Updates the user record on loging off/exiting RBBS-PC
' VarInit 109 Initialize system variables
' ViewHelp 1330 Processes help command
' WhoCheck 2250 Checks whether a user exists in user file
' WhosOn 9801 Report status of each node - who's on
' WordInFile 10976 Find a whole word within a file/menu
2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
' $PAGE
'
' NAME -- MessageTo
'
' INPUTS -- PARAMETER MEANING
' HighestUserRecord
'
' OUTPUTS -- MsgTo$ Who message is to
' RcvrRecNum User record # of who to
'
' PURPOSE -- Asks who a message is to and determines if receiver exists
'
SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
Temp$ = MsgFrom$
CALL Trim (Temp$)
2020 IF MsgTo$ <> "" THEN _
GOTO 2032
ZOutTxt$ = "To: [A]ll,S)ysop or Name (2 Char. Min.)" ' TC090101/PEEK173C
CALL SkipLine (1) ' TC090101/PEEK173C
ZParseOff = ZTrue
GOSUB 2033
IF LEN(ZUserIn$) > 30 THEN _
CALL QuickTPut1 ("30 Chars Max.") : _ ' TC090101
GOTO 2020
IF LEFT$(ZUserIn$,1) = " " THEN _ ' PEEK173C
CALL SkipLine (1) : _ ' PEEK173C
CALL QuickTPut1 ("Name can't begin with a SPACE") : _ ' PEEK173C
CALL SkipLine (1) : _ ' PEEK173C
GOTO 2020 ' PEEK173C
2030 Found = ZTrue
IF ZWasQ = 0 THEN _
MsgTo$ = "ALL" : _ ' PEEK173C
GOTO 2032 _ ' PEEK173C
ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _ ' PEEK173C
CALL AllCaps (ZWasDF$) : _ ' PEEK173C
ZUserIn$(ZAnsIndex) = ZWasDF$ : _ ' PEEK173C
MsgTo$ = ZWasDF$ : _ ' PEEK173C
IF ZWasDF$ = "A" THEN _ ' PEEK173C
MsgTo$ = "ALL" _ ' PEEK173C
ELSE IF ZWasDF$ = "S" THEN _ ' PEEK173C
MsgTo$ = "SYSOP" _ ' PEEK173C
ELSE MsgTo$ = ZWasDF$ ' PEEK173C
GOTO 2032 ' PEEK173C
2032 RcvrRecNum = 0 ' PEEK173C
IF MsgTo$ <> "ALL" THEN _ ' PEEK173C
IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
ZWasDF = INSTR(MsgTo$+" @"," @") : _ ' KG052201
TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _ ' KG052201
CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
CALL QuickPeek (ZUserIn$(ZAnsIndex),MsgTo$,Found) : _ ' PEEK173C
' CALL AliasChk (MsgTo$,Found,UserNumFound) : _ ' MPLALIAS uncomment the beginning of the line if you are using the MPLALIAS merge
IF NOT Found THEN _
CALL QuickTPut1 (MsgTo$ + " not active user") : _ ' PEEK173C
ZLastIndex = 0 : _
RcvrRecNum = 0 : _ ' KG060901
IF NOT ZReply THEN _
ZOutTxt$ = "[R]e-Enter Name, Q)uit, C)ontinue" : _ ' TC090101
ZTurboKey = -ZTurboKeyUser : _
ZLastIndex = 0 : _
GOSUB 2033 : _
ZWasZ$ = ZUserIn$(1) : _
CALL AllCaps (ZWasZ$) : _
IF ZWasZ$ <> "C" THEN _
MsgTo$ = "" : _
IF ZWasZ$ <> "Q" THEN _
GOTO 2020
IF MsgTo$ = Temp$ THEN _
ZOutTxt$ = "Message is To AND From You. Really Do This (Y,[N])" : _ ' TC090101
ZLastIndex = 0 : _
GOSUB 2033 : _
IF NOT ZYes THEN _
MsgTo$ = ""
EXIT SUB
2033 CALL PopCmdStack
IF ZSubParm < 0 THEN _
EXIT SUB
RETURN
END SUB
20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
' $PAGE
'
' NAME -- FileNameCheck
'
' INPUTS -- PARAMETER MEANING
' CheckThis$ Name of file to check
' Pref2$ Prefix to match against
' Ext2$ Extension to match against
'
' OUTPUTS -- ZOK 1 if got match
'
' PURPOSE -- Checks for match on both prefix and extension of a file
' name. Used to catch match on system files not to be
' downloaded.
'
SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
IF ZOK > 0 THEN _
EXIT SUB
CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
IF Pref1$ = Pref2$ THEN _
IF Ext1$ = Ext2$ THEN _
ZOK = 1
END SUB
20340 ' $SUBTITLE: 'QuickPeek - Easy find user to send message to' ' DD030692
' $PAGE ' PEEK173C
' ' PEEK173C
' NAME -- QuickPeek ' PEEK173C
' ' PEEK173C
' INPUTS -- PARAMETER MEANING ' PEEK173C
' ' PEEK173C
' OUTPUTS -- ZUserIn$ Search String User Input ' PEEK173C
' MsgTo$ Who Message is To ' PEEK173C
' PURPOSE -- Save User keystrokes when looking for message addressee' PEEK173C
' ' PEEK173C
SUB QuickPeek (ZUserIn$,MsgTo$,WhoFound) Static ' PEEK173C
IF WhoFound = ZTrue THEN EXIT SUB ' PEEK173C
ZLastDateTimeOnSave$ = ZLastDateTimeOn$ ' PEEK173C
UserInName$ = ZUserIn$ ' PEEK173C
WhichUser = 1 ' PEEK173C
CALL OpenUser (ZHighestUserRecord) ' PEEK173C
WHILE NOT EOF(5) ' PEEK173C
GET #5, WhichUser ' PEEK173C
TempMsgTo$ = ZUserName$ ' PEEK173C
CALL TRIM (TempMsgTo$) ' PEEK173C
IF UserInName$ = TempMsgTo$ THEN EXIT SUB ' PEEK173C
IF INSTR(TempMsgTo$,UserInName$) > 0 THEN ' PEEK173C
ZSubParm = 1 ' PEEK173C
ZOutTxt$ = "Send to: " + TempMsgTo$ + " (Y)es, [N])o, A)bort)" ' PEEK173C
ZTurboKey = -ZTurboKeyUser ' PEEK173C
CALL PopCmdStack ' PEEK173C
IF ZSubParm = -1 THEN _ ' PEEK173C
EXIT SUB ' PEEK173C
ZWasZ$ = ZUserIn$(1) ' PEEK173C
CALL AllCaps (ZWasZ$) ' PEEK173C
IF ZWasZ$ = "A" THEN _ ' PEEK173C
EXIT SUB ' PEEK173C
' IF ZWasQ = 0 THEN _ ' PEEK173C
' ZYes = ZTrue ' PEEK173C
' CALL AllCaps (ZUserIn$) ' PEEK173C
IF ZWasZ$ = "Y" THEN ' PEEK173C
MsgTo$ = TempMsgTo$ ' PEEK173C
ZUserIn$ = TempMsgTo$ ' PEEK173C
WhoFound = ZTrue ' PEEK173C
ZLastDateTimeOn$ = ZLastDateTimeOnSave$ ' PEEK173C
EXIT SUB ' PEEK173C
ELSE ' PEEK173C
WhichUser=WhichUser+1 ' PEEK173C
END IF ' PEEK173C
ELSE ' PEEK173C
WhichUser=WhichUser+1 ' PEEK173C
END IF ' PEEK173C
WEND ' PEEK173C
ZLastDateTimeOn$ = ZLastDateTimeOnSave$ ' PEEK173C
END SUB ' PEEK173C